Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/nhx/main.bas

BASIC Source File | 1995-05-09 | 5KB | 227 lines

Sub DoSave ()
For i% = 0 To TopicCount%
    SaveHyperText (i%)
    Next

End Sub

Function FindAndShowTopic% (a$)
    On Error GoTo Err2

    a$ = Mid$(a$, InStr(a$, "[") + 1)
    BracketPos% = InStr(a$, "]")
    If BracketPos% > 0 Then a$ = Left$(a$, BracketPos% - 1)

    If Left$(a$, 3) = "run" Then
        a$ = Mid$(a$, 4)
        a$ = RTrim$(LTrim$(a$))
        i% = Shell(a$, 1)
        FindAndShowTopic = 0
        Exit Function
    Else
        For i% = 0 To TopicCount%
            If mainform.texttopic(i%).tag = a$ Then
                ShowTopic i%
                FindAndShowTopic = -1
                Exit Function
                End If
            Next
    End If

MsgBox "couldnt find topic " + a$
FindAndShowTopic = 0
Exit Function

Err2:
    If Err = 360 Then 'obj already loaded
        Resume Next
    ElseIf Err = 53 Then 'file not found
        MsgBox "file " + filename$ + "not found"
        Exit Function
    Else
        MsgBox "LoadHyper err" + Error$(Err) + " " + Str$(Err)
        Resume Next
    End If

End Function

Function FindTopic% (a$)
    On Error GoTo Err4

    a$ = Mid$(a$, InStr(a$, "[") + 1)
    BracketPos% = InStr(a$, "]")
    If BracketPos% > 0 Then a$ = Left$(a$, BracketPos% - 1)

    If LCase$(Left$(a$, 3)) = "run" Then
        a$ = Mid$(a$, 4)
        a$ = RTrim$(LTrim$(a$))
        i% = Shell(a$, 1)
        FindTopic = 0
        Exit Function
    Else
        For i% = 0 To TopicCount%
            If mainform.texttopic(i%).tag = a$ Then
                FindTopic = i%
                Exit Function
                End If
            Next
    End If

MsgBox "couldnt find topic " + a$
FindTopic = 0
Exit Function

Err4:
    If Err = 360 Then 'obj already loaded
        Resume Next
    ElseIf Err = 53 Then 'file not found
        MsgBox "file " + filename$ + "not found"
        Exit Function
    Else
        MsgBox "LoadHyper err" + Error$(Err) + " " + Str$(Err)
        Resume Next
    End If

End Function

Sub HideTopic (i%)
    mainform.texttopic(i%).sellength = 0
    mainform.texttopic(i%).visible = 0
End Sub

Sub LoadHyperText (filename$, editbox%)
On Error GoTo Err1
Load mainform.texttopic(editbox%)
mainform.texttopic(editbox%).tag = filename$
Open filename$ For Input As #1
FirstTime% = -1
While Not EOF(1)
    Line Input #1, a$
    If Left$(a$, 1) = ";" Then
    Else
        If FirstTime% = 0 Then b$ = b$ + NL$
        b$ = b$ + a$
    End If
    FirstTime% = 0
    Wend

Close #1
mainform.texttopic(editbox%).text = b$
TopicCount% = editbox%
Exit Sub

Err1:
    If Err = 360 Then 'obj already loaded
        Resume Next
    ElseIf Err = 53 Then 'file not found
        MsgBox "file " + filename$ + "not found"
        Exit Sub
    Else
        MsgBox "LoadHyper err" + Error$(Err) + " " + Str$(Err)
        Resume Next
    End If

End Sub


Sub main ()
NL$ = Chr$(13) + Chr$(10)
Q$ = Chr$(34)
LoadHyperText "nhx.nhx", 0
a$ = mainform.texttopic(0).text

CurrentTopic% = 1
Do
    If Len(a$) <= 0 Then Exit Do
    BracketPos% = InStr(a$, "[") + 1
    If BracketPos% = 1 Then Exit Do
    a$ = Mid$(a$, BracketPos%)
    BracketPos% = InStr(a$, "]") - 1
    If BracketPos% <> 1 Then
        b$ = Left$(a$, BracketPos%)
        LoadHyperText b$, CurrentTopic%
        CurrentTopic% = CurrentTopic% + 1
        End If
    Loop
CurrentTopic% = 0
mainform.Show
End Sub

Function NewHyperText$ ()
nhx$ = UCase$(mainform.texttopic(0).text)

Do
    i% = 1
    Do
        a$ = "Topic" + LTrim$(Format$(i%, "######")) + ".nhx"
        b$ = UCase$(a$)
        If InStr(nhx$, b$) = 0 Then Exit Do
        If i% > 32000 Then Exit Function
        i% = i% + 1
        Loop
    a$ = InputBox$("enter filename for new topic", APPNAME$, a$)
    b$ = UCase$(a$)

    ' validate the filename

    filename$ = a$: ext$ = ""
    dotpos% = InStr(a$, ".")
    If dotpos% Then
        filename$ = Left$(Left$(a$, dotpos% - 1), 8)
        ext$ = Mid$(a$, dotpos% + 1)
        End If

    filename$ = Left$(filename$, 8)
    If ext$ = "" Then ext$ = ".nhx"
    filename$ = filename$ + ext$
    a$ = filename$
    b$ = UCase$(a$)
    If InStr(nhx$, b$) = 0 Then Exit Do
    MsgBox "sorry, " + a$ + " is already in use, think of another name"
    Loop

If Dir$(a$) = "" Then
    Open a$ For Output As #1
    Print #1, "File " + a$
    Close #1
    End If
mainform.texttopic(0).text = mainform.texttopic(0).text + NL$ + "[" + a$ + "]"
LoadHyperText a$, TopicCount% + 1

NewHyperText = "[" + a$ + "]"
End Function

Sub ni ()
MsgBox "Sorry, feature not implemented yet"
End Sub

Sub SaveHyperText (editbox%)
On Error GoTo Err3
filename$ = mainform.texttopic(editbox%).tag
Open filename$ For Output As #1
Print #1, mainform.texttopic(editbox%).text
Close
Close #1
Exit Sub

Err3:
    If Err = 360 Then 'obj already loaded
        Resume Next
    ElseIf Err = 53 Then 'file not found
        MsgBox "file " + filename$ + "not found"
        Exit Sub
    Else
        MsgBox "LoadHyper err" + Error$(Err) + " " + Str$(Err)
        Resume Next
    End If

End Sub

Sub ShowTopic (i%)
    mainform.texttopic(i%).visible = -1
    CurrentTopic% = i%
End Sub